home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr26 / 4utils73.zip / 4DESC.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-01  |  29KB  |  870 lines
  1. PROGRAM FileDescEditor;
  2. {$A+,B-,D-,E-,F-,G+,L+,N-,O-,R+,S+,V-,X-}
  3. {$M 8192,0,655360}
  4.  
  5. (* ----------------------------------------------------------------------
  6.    A Simple 4DOS File Description Editor
  7.  
  8.    (c) 1992, 1993 Copyright by
  9.  
  10.        David Frey,         & Tom Bowden
  11.        Urdorferstrasse 30    1575 Canberra Drive
  12.        8952 Schlieren ZH     Stone Mountain, GA 30088-3629
  13.        Switzerland           USA
  14.  
  15.        Code created using Turbo Pascal 7.0, (c) Borland International 1992
  16.  
  17.    DISCLAIMER: This program is freeware: you are allowed to use, copy
  18.                and change it free of charge, but you may not sell or hire
  19.                4DESC. The copyright remains in our hands.
  20.  
  21.                If you make any (considerable) changes to the source code,
  22.                please let us know. (send a copy or a listing).
  23.                We would like to see what you have done.
  24.  
  25.                We, David Frey and Tom Bowden, the authors, provide absolutely
  26.                no warranty of any kind. The user of this software takes the
  27.                entire risk of damages, failures, data losses or other
  28.                incidents.
  29.  
  30.    NOTES:      4DESC was modified extensively by Tom Bowden,
  31.                August-October 1992.
  32.  
  33.                Among the changes:
  34.  
  35.                Screen layout now resembles the 4DOS SELECT screen.
  36.                (The original screen had apparently been based on Larry
  37.                Edwards' 4FILES).
  38.  
  39.                The display now is sorted.
  40.  
  41.                The program now is always in edit mode.
  42.  
  43.                Alt-T (cuT to buffer) now is Alt-M (Move to buffer).
  44.                Alt-D now deletes a file description.
  45.                Alt-X now exits the program.
  46.  
  47.                F1 now displays a help screen.
  48.                F2 now changes drive.
  49.                F3 now changes to the highlighted directory.
  50.                F4 now changes to the parent directory.
  51.                F10 now saves the current file descriptions.
  52.  
  53.                The screen colors were changed, and stored as CONST for
  54.                easier maintenance.  VGA is no longer required.
  55.  
  56.                4DESC can now write and display file descriptions for
  57.                directory entries.
  58.  
  59.                SaveDescriptions now strips trailing spaces from
  60.                file extensions and leading and trailing spaces from
  61.                file descriptions.
  62.  
  63.                4DESC does not presently write file descriptions longer
  64.                than 40 characters.  When saving, any longer descriptions
  65.                in the current directory will be truncated.  The user is
  66.                warned when reading a directory having extended file
  67.                descriptions.
  68.  
  69.                Handling of extended program information has not been tested.
  70.  
  71.    ADDITIONS TO TOM BOWDENS'S IMPROVEMENTS BY DAVID FREY:
  72.  
  73.                I have split 4DESC.PAS into units:
  74.                 StringDateHandling, DisplayKeyboardAndCursor, HandleINIFile
  75.  
  76.                Monochrome / Color display detection. /mono switch.
  77.  
  78.                Insert mode cursor is underline, overwrite is block cursor.
  79.                (as in 4DOS)
  80.  
  81.                Since 4DOS 4.01 has introduced the `DescriptionMax' statement;
  82.                references to fix description lengths have been removed.
  83.  
  84.                4DESC is now international: it chooses the appropriate date
  85.                and time formats on startup. [by using DOS's function $38:
  86.                Get/Set Country Data. DOS get the country information via
  87.                COUNTRY= and COUNTRY.SYS].
  88.  
  89.                4TOOLS.INI file introduced. Colors and Time/Date formats can
  90.                now be changed without recompiling 4DESC.PAS (for people
  91.                without Turbo Pascal). 4DESC checks its startup directory,
  92.                environment variable 4TOOLS and PATH to locate 4TOOLS.INI.
  93.  
  94.                "Change drive" will not change to drives which are not ready.
  95.  
  96.    A few new tweaks by Tom Bowden:
  97.  
  98.                "Change drive" will not change to drives which contain
  99.                no files.
  100.  
  101.                New handling of command line parameters.  The /mono, /help,
  102.                and selected directory params may be used together.  Note
  103.                that the optional selected directory must be the last
  104.                parameter entered.
  105.  
  106.                The status line now displays the 4DOS version (if running
  107.                under 4DOS), and shows "Edit" and Cut" rather than "*"
  108.                and "()".
  109.  
  110.    More additions by David Frey:
  111.  
  112.                Maximum number of files in a directory raised to 417
  113.                descriptions. A warning ("Description file will be truncated")
  114.                will appear if more than MaxDesc files are stored in a
  115.                directory going to be edited with 4DESC.
  116.                This prevents unintentional cutting of your description file.
  117.  
  118.                Yet another function key binding:
  119.                 F3 : View file (with list - whatever list may be
  120.                                 (internal 4DOS, external viewer))
  121.                 F4 : Change Dir
  122.                 F5 : Change to parent
  123.                 F6 : Change drive
  124.  
  125.                In 4TOOLS.INI the LeftJust variable has been added.
  126.  
  127.                Shelling out to 4DOS has been added (Alt-S or Shift-F10)
  128.  
  129.    More additions by Tom Bowden:
  130.  
  131.                In 4TOOLS.INI the FullSize and Viewer variables have
  132.                been added.
  133.                Get4DOSVer has been modified to display the correct
  134.                minor version number and to check for NDOS.
  135.  
  136.    ADDITIONS TO TOM BOWDENS'S IMPROVEMENTS BY DAVID FREY:
  137.  
  138.    ||          Static description management has been replaced by a dynamic
  139.    ||          one, i.e. the description data will be allocated on the heap.
  140.  
  141.                4DESC uses a TCollection (a Turbo Vision Object) to handle the
  142.                descriptions. The description handling resides in DESCRIPT.PAS.
  143.  
  144.                Upper file limit (per directory) is now
  145.  
  146.                 min { MaxCollectionSize = 16'380, available base memory }
  147.  
  148.  
  149.                A Delimiters-variable has been added, specifying legal
  150.                separators between words (used by Ctrl-Left / Right = Move
  151.                a word to the left / right)
  152.  
  153.    ----------------------------------------------------------------------- *)
  154.  
  155. USES {$IFOPT G+} Test286, {$ENDIF}
  156.      Crt, Dos,
  157.      Memory,
  158.      StringDateHandling, DisplayKeyboardAndCursor, HandleINIFile,
  159.      DescriptionHandling;
  160.  
  161. CONST DelimiterTable : STRING = ',.();:-!?/[]{}+*=''`"@%&$_£';
  162.  
  163. VAR  EdStart     : BYTE;
  164.      DescLen     : BYTE;
  165.  
  166.      ActDir      : DirStr;
  167.      StartDir    : DirStr;
  168.  
  169.      StartIndex  : INTEGER;
  170.      Index       : INTEGER;
  171.  
  172.      CutPasteDesc: DescStr;
  173.      Changed     : BOOLEAN;
  174.      IORes       : INTEGER;
  175.  
  176.      NewDir      : DirStr;
  177.      NewName     : NameStr;
  178.      NewExt      : ExtStr;
  179.  
  180.      FirstParam  : STRING[2];
  181.      i           : BYTE;
  182.      DoShowHelp  : BOOLEAN;
  183.  
  184. (*-------------------------------------------------------- Display-Routines *)
  185. PROCEDURE WriteFileEntry(Index: INTEGER; Hilighted: BOOLEAN);
  186.  
  187. VAR FileEntry : PFileData;
  188.  
  189. BEGIN
  190.  GotoXY(1,3+Index-StartIndex);
  191.  IF (Index >= 0) AND (Index < FileList^.Count) THEN
  192.   BEGIN
  193.    FileEntry := NILCheck(FileList^.At(Index));
  194.  
  195.    IF Hilighted THEN
  196.     BEGIN TextColor(SelectFg); TextBackGround(SelectBg); END
  197.    ELSE
  198.     BEGIN
  199.      TextBackGround(NormBg);
  200.  
  201.      IF FileEntry^.GetSize <> DirSize THEN TextColor(NormFg)
  202.                                       ELSE TextColor(DirFg)
  203.     END;
  204.    Write(FileEntry^.FormatDescription);
  205.    IF Length(FileEntry^.GetDesc) < DescLen THEN ClrEol;
  206.   END
  207.  ELSE ClrEol;
  208. END;  (* WriteFileEntry *)
  209.  
  210. PROCEDURE DrawDirLine;
  211.  
  212. BEGIN
  213.  GetDir(0,ActDir);
  214.  IF ActDir[Length(ActDir)] <> '\' THEN ActDir := ActDir + '\';
  215.  UpString(ActDir);
  216.  TextColor(DirFg); TextBackGround(NormBg);
  217.  GotoXY(1,2); Write(' ',ActDir); ClrEol;
  218. END; (* DrawDirLine *)
  219.  
  220. PROCEDURE ReDrawScreen;
  221.  
  222. VAR Index: INTEGER;
  223.  
  224. BEGIN
  225.  GetDir(0,ActDir);
  226.  FOR Index := StartIndex TO StartIndex+MaxLines-4 DO
  227.   WriteFileEntry(Index,FALSE);
  228. END; (* ReDrawScreen *)
  229.  
  230.  
  231. (*-------------------------------------------------------- Read-Directory *)
  232. PROCEDURE ReadFiles;
  233.  
  234. VAR i              : BYTE;
  235.     ch             : WORD;
  236.     Dir            : PathStr;
  237.  
  238. BEGIN
  239.  Changed := FALSE; DescLong := FALSE;
  240.  Index   := 0; StartIndex := 0;
  241.  Dir := FExpand('.');
  242.  
  243.  IF FileList <> NIL THEN
  244.   BEGIN
  245.    Dispose(FileList,Done); FileList := NIL;
  246.   END;
  247.  
  248.  TextColor(StatusFg); TextBackGround(StatusBg);
  249.  GotoXY(1,MaxLines); Write('Scanning directory `',Dir,'''.....  please wait.'); ClrEol;
  250.  
  251.  FileList := NIL; FileList := New(PFileList,Init(Dir));
  252.  IF FileList = NIL THEN Abort('Unable to allocate FileList');
  253.  
  254.  IF (FileList^.Status = ListTooManyFiles) OR
  255.     (FileList^.Status = ListOutofMem) THEN
  256.   BEGIN
  257.    TextColor(NormFg); TextBackGround(NormBg);
  258.    FOR i := 3 TO MaxLines-1 DO
  259.     BEGIN
  260.      GotoXY(1,i); ClrEol;
  261.     END;
  262.    IF FileList^.Status = ListTooManyFiles THEN
  263.     ReportError('Warning! Too many files in directory, description file will be truncated! (Key)',(CutPasteDesc <> ''),Changed)
  264.    ELSE
  265.     ReportError('Warning! Out of memory, description file will be truncated! (Key)',(CutPasteDesc <> ''),Changed);
  266.   END;
  267.  
  268.  IF FileList^.Count > 0 THEN
  269.   BEGIN
  270.    DrawMainScreen(Index,FileList^.Count);
  271.    DrawDirLine;
  272.   END;
  273.  
  274.  IF DescLong THEN
  275.   BEGIN
  276.    TextColor(NormFg); TextBackGround(NormBg);
  277.    FOR i := 3 TO MaxLines-1 DO
  278.     BEGIN
  279.      GotoXY(1,i); ClrEol;
  280.     END;
  281.    ReportError('Warning! Some descriptions are too long; they will be truncated. Press any key.',(CutPasteDesc <> ''),Changed);
  282.   END;
  283. END;  (* ReadFiles *)
  284.  
  285. (*-------------------------------------------------------- Save Descriptions *)
  286. PROCEDURE SaveDescriptions;
  287.  
  288. VAR DescFile : TEXT;
  289.     DescSaved: BOOLEAN;
  290.     Time     : DateTime;
  291.     ch       : WORD;
  292.     FileEntry: PFileData;
  293.     
  294.  
  295.  PROCEDURE SaveEntry(FileEntry: PFileData); FAR;
  296.  
  297.  VAR Desc     : DescStr;
  298.      ProgInfo : STRING;
  299.      Dir      : DirStr;
  300.      BaseName : NameStr;
  301.      Ext      : ExtStr;
  302.  
  303.  BEGIN
  304.   Desc := FileEntry^.GetDesc;
  305.   IF Desc <> '' THEN
  306.    BEGIN
  307.     FSplit(FileEntry^.GetName,Dir,Basename,Ext);
  308.     StripTrailingSpaces(BaseName);
  309.     Write(DescFile,BaseName);
  310.  
  311.     StripLeadingSpaces(Ext);
  312.     StripTrailingSpaces(Ext);
  313.     IF Ext <> '' THEN Write(DescFile,Ext);
  314.  
  315.     StripLeadingSpaces(Desc); StripTrailingSpaces(Desc);
  316.     Write(DescFile,' ',Desc);
  317.  
  318.     ProgInfo :=  FileEntry^.GetProgInfo;
  319.     IF ProgInfo <> '' THEN Write(DescFile,#4,ProgInfo);
  320.     WriteLn(DescFile);
  321.    END;
  322.  END; (* SaveEntry *)
  323.  
  324. BEGIN
  325.  DescSaved := FALSE;
  326.  IF DiskFree(0) < FileList^.Count*SizeOf(TFileData) THEN
  327.   ReportError('Probably out of disk space. Nevertheless trying to save DESCRIPT.ION...',(CutPasteDesc <> ''),Changed);
  328.  
  329.  TextColor(StatusFg); TextBackGround(StatusBg);
  330.  GotoXY(1,MaxLines); Write('Saving descriptions........  please wait.'); ClrEol;
  331.  
  332.  Assign(DescFile,'DESCRIPT.ION'); SetFAttr(DescFile,Archive);
  333.  Rewrite(DescFile);
  334.  IF IOResult > 0 THEN ReportError('Unable to write DESCRIPT.ION !',(CutPasteDesc <> ''),Changed)
  335.  ELSE
  336.   BEGIN FileList^.ForEach(@SaveEntry); DescSaved := TRUE; END;
  337.  {$I-}
  338.  Close(DescFile);
  339.  {$I+}
  340.  
  341.  IF IOResult > 0 THEN ReportError('Unable to write DESCRIPT.ION !',(CutPasteDesc <> ''),Changed)
  342.  ELSE
  343.   BEGIN
  344.    IF DescSaved THEN SetFAttr(DescFile, Archive + Hidden)
  345.                 ELSE Erase(DescFile);  (* Don't keep zero-byte file. *)
  346.    Changed := FALSE; DrawStatusLine(TRUE,(CutPasteDesc <> ''),Changed);
  347.   END;
  348. END;  (* SaveDescriptions *)
  349.  
  350. (*-------------------------------------------------------- Edit Descriptions *)
  351. PROCEDURE EditDescriptions;
  352.  
  353. CONST kbLeft     = $4B00;   kbRight    = $4D00;
  354.       kbUp       = $4800;   kbDown     = $5000;
  355.       kbHome     = $4700;   kbEnd      = $4F00;
  356.       kbPgUp     = $4900;   kbPgDn     = $5100;
  357.       kbCtrlLeft = $7300;   kbCtrlRight= $7400;
  358.       kbCtrlPgDn = $7600;   kbCtrlPgUp = $8400;
  359.       kbCtrlHome = $7700;   kbCtrlEnd  = $7500;
  360.       kbEnter    = $0D;     kbEsc      = $1B;
  361.  
  362.       kbIns      = $5200;   kbDel      = $5300;
  363.       kbBack     = $08;
  364.  
  365.       kbGrayMinus= $4A2D;   kbGrayPlus = $4E2B;
  366.  
  367.       kbAltC     = $2E00;   kbAltP     = $1900;
  368.       kbAltD     = $2000;   kbAltL     = $2600;
  369.       kbAltM     = $3200;   kbAltT     = $1400;
  370.       kbAltS     = $1F00;   kbAltV     = $2F00;
  371.       kbAltX     = $2D00;
  372.  
  373.       kbF1       = $3B00;   kbF2       = $3C00;
  374.       kbF3       = $3D00;   kbF4       = $3E00;
  375.       kbF5       = $3F00;   kbF6       = $4000;
  376.       kbF10      = $4400;   kbShiftF10 = $5D00;
  377.  
  378. VAR Key          : WORD;
  379.     Drv          : STRING[3];
  380.     LastDrv      : CHAR;
  381.     x,y,l        : BYTE;
  382.     EditStr      : DescStr;
  383.     Overwrite    : BOOLEAN;
  384.     Cursor       : WORD;
  385.     OldDir       : DirStr;
  386.     ActFileData  : PFileData;
  387.     n            : NameExtStr;
  388.  
  389.  PROCEDURE UpdateLineNum(Index: INTEGER);
  390.  
  391.  BEGIN
  392.   WriteFileEntry(Index,TRUE);
  393.   TextColor(StatusFg); TextBackGround(StatusBg);
  394.   GotoXY(66,1); Write(Index+1:5);
  395.  
  396.   IF Changed THEN DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  397.  
  398.   IF Index < FileList^.Count THEN
  399.    BEGIN
  400.     x := 1;
  401.     y := 3+Index-StartIndex;
  402.     GotoXY(EdStart,y);
  403.     TextColor(SelectFg); TextBackGround(SelectBg);
  404.     EditStr := PFileData(FileList^.At(Index))^.GetDesc;
  405.     Write(EditStr);
  406.     IF Length(EditStr) < DescLen THEN ClrEol;
  407.     GotoXY(EdStart+x-1,y);
  408.    END;
  409.  
  410.   ActFileData := NILCheck(FileList^.At(Index));
  411.  END;
  412.  
  413.  PROCEDURE PrevIndex(VAR Index: INTEGER);
  414.  
  415.  BEGIN
  416.   Index := Max(Index-1,0);
  417.   IF Index <= StartIndex THEN
  418.    BEGIN
  419.     StartIndex := Max(Index-ScreenSize,0);
  420.     RedrawScreen;
  421.    END;
  422.   UpdateLineNum(Index);
  423.  END; (* NextIndex *)
  424.  
  425.  PROCEDURE NextIndex(VAR Index: INTEGER);
  426.  
  427.  BEGIN
  428.   Index := Min(Index+1,FileList^.Count-1);
  429.   IF Index > StartIndex+ScreenSize THEN
  430.    BEGIN
  431.     StartIndex := Index-ScreenSize;
  432.     RedrawScreen;
  433.    END;
  434.   UpdateLineNum(Index);
  435.  END; (* NextIndex *)
  436.  
  437.  PROCEDURE QuerySaveDescriptions;
  438.  
  439.  VAR ch: CHAR;
  440.  
  441.  BEGIN
  442.   TextColor(StatusFg); TextBackGround(StatusBg);
  443.   IF Changed THEN
  444.    BEGIN
  445.     REPEAT
  446.      GotoXY(1,MaxLines);
  447.      Write(Chars(' ',11));
  448.      Write('Descriptions have been edited. Shall they be saved (Y/N) ?');
  449.      ClrEol;
  450.      ch := UpCase(ReadKey);
  451.     UNTIL (ch = 'Y') OR (ch = 'N');
  452.     IF ch = 'Y' THEN SaveDescriptions;
  453.    END;
  454.  END; (* QuerySaveDescriptions *)
  455.  
  456.  PROCEDURE DirUp;
  457.  
  458.  BEGIN
  459.   IF Changed THEN QuerySaveDescriptions;
  460.   ChDir('..');
  461.   IF IOResult = 0 THEN
  462.    BEGIN
  463.     ReadFiles;
  464.     RedrawScreen;
  465.  
  466.     DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  467.     Index := 0; UpdateLineNum(Index);
  468.    END;
  469.  END;  (* DirUp *)
  470.  
  471.  PROCEDURE DirDown;
  472.  
  473.  BEGIN
  474.   IF (Index < FileList^.Count) THEN
  475.    BEGIN
  476.     n  := ActFileData^.GetName;
  477.     IF (ActFileData^.GetSize = DirSize) AND (n[1] <> '.') THEN
  478.      BEGIN
  479.       IF Changed THEN QuerySaveDescriptions;
  480.       ChDir(n);
  481.       IF IOResult = 0 THEN
  482.        BEGIN
  483.         ReadFiles;
  484.         RedrawScreen;
  485.        END;
  486.       DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  487.       Index := 0; UpdateLineNum(Index);
  488.     END;  (* IF Description[Index].Size = DirSize *)
  489.    END;
  490.  END;  (* DirDown *)
  491.  
  492.  FUNCTION IsADelimiter(c: CHAR): BOOLEAN;
  493.  (* used by Ctrl-Left resp Ctrl-Right *)
  494.  
  495.  BEGIN
  496.   IsADelimiter := (Pos(c,DelimiterTable) > 0);
  497.  END;
  498.  
  499. BEGIN  (* EditDescriptions *)
  500.  Index := 0; UpdateLineNum(Index);
  501.  
  502.  Overwrite := FALSE; ResetCursor(Overwrite);
  503.  EditStr := ActFileData^.GetDesc;
  504.  
  505.  REPEAT
  506.   Key := GetKey;
  507.   CASE Key OF
  508.    kbUp       : BEGIN
  509.                  ActFileData^.AssignDesc(EditStr); WriteFileEntry(Index,FALSE);
  510.                  PrevIndex(Index); 
  511.                 END; (* Up *)
  512.  
  513.    kbDown     : BEGIN
  514.                  ActFileData^.AssignDesc(EditStr); WriteFileEntry(Index,FALSE);
  515.                  NextIndex(Index);
  516.                 END; (* Down *)
  517.  
  518.    kbLeft     : BEGIN
  519.                  x := Max(1,x-1);
  520.                  GotoXY(EdStart+x-1,y);
  521.                 END; (* Left *)
  522.  
  523.    kbRight    : BEGIN
  524.                  IF (x <= Length(EditStr)) AND (x < DescLen) THEN INC(x);
  525.                  GotoXY(EdStart+x-1,y);
  526.                 END; (* Right *)
  527.  
  528.    kbCtrlLeft : BEGIN
  529.                  DEC(x);
  530.                  WHILE (x > 0) AND IsADelimiter(EditStr[x]) DO DEC(x);
  531.                  WHILE (x > 0) AND NOT IsADelimiter(EditStr[x]) DO DEC(x);
  532.                  INC(x); GotoXY(EdStart+x-1,y);
  533.                 END;
  534.  
  535.    kbCtrlRight: BEGIN
  536.                  l := Length(EditStr);
  537.                  WHILE (x < l) AND NOT IsADelimiter(EditStr[x]) DO INC(x);
  538.                  WHILE (x < l) AND IsADelimiter(EditStr[x]) DO INC(x);
  539.                  GotoXY(EdStart+x-1,y);
  540.                 END;
  541.  
  542.    kbHome     : BEGIN
  543.                  x := 1;
  544.                  GotoXY(EdStart+x-1,y);
  545.                 END; (* Home *)
  546.  
  547.    kbEnd      : BEGIN
  548.                  x := Length(EditStr);
  549.                  IF x < DescLen THEN INC(x);
  550.                  GotoXY(EdStart+x-1,y);
  551.                  END; (* End *)
  552.  
  553.    kbCtrlEnd  : BEGIN
  554.                  Delete(EditStr,x,DescLen);
  555.                  ActFileData^.AssignDesc(EditStr);
  556.                  WriteFileEntry(Index,TRUE);
  557.  
  558.                  Changed := TRUE;
  559.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  560.                 END;  (* ^End *)
  561.  
  562.    kbIns      : BEGIN
  563.                  Overwrite := NOT Overwrite;
  564.                  ResetCursor(Overwrite);
  565.                 END; (* Ins *)
  566.  
  567.    kbDel      : BEGIN
  568.                  IF x <= Length(EditStr) THEN Delete(EditStr,x,1);
  569.                  ActFileData^.AssignDesc(EditStr);
  570.                  WriteFileEntry(Index,TRUE);
  571.  
  572.                  Changed := TRUE;
  573.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  574.  
  575.                  GotoXY(EdStart+x-1,y);
  576.                 END; (* Del *)
  577.  
  578.    kbBack     : BEGIN
  579.                  Delete(EditStr,x-1,1);
  580.                  ActFileData^.AssignDesc(EditStr);
  581.                  IF x > 1 THEN
  582.                   BEGIN
  583.                    DEC(x);
  584.                    IF x > Length(EditStr) THEN x := Length(EditStr)+1;
  585.                   END;
  586.                  WriteFileEntry(Index,TRUE);
  587.  
  588.                  Changed := TRUE;
  589.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  590.                  GotoXY(EdStart+x-1,y);
  591.                 END; (* Back *)
  592.  
  593.    kbPgUp     : BEGIN
  594.                  ActFileData^.AssignDesc(EditStr);
  595.                  WriteFileEntry(Index,FALSE);
  596.                  
  597.                  Index := Max(Index-ScreenSize,0);
  598.                  StartIndex := Index;
  599.                  RedrawScreen;
  600.                  UpdateLineNum(Index);
  601.                 END; (* PgUp *)
  602.  
  603.    kbPgDn     : BEGIN
  604.                  ActFileData^.AssignDesc(EditStr); 
  605.                  Index := Min(Index+ScreenSize,FileList^.Count-1);
  606.                  StartIndex := Max(Index-ScreenSize,0);
  607.                  WriteFileEntry(Index,FALSE);
  608.  
  609.                  RedrawScreen;
  610.                  UpdateLineNum(Index);
  611.                 END; (* PgDn *)
  612.  
  613.    kbCtrlPgUp : BEGIN
  614.                  ActFileData^.AssignDesc(EditStr);
  615.                  WriteFileEntry(Index,FALSE);
  616.  
  617.                  StartIndex := 0; Index := 0;
  618.                  RedrawScreen;
  619.                  UpdateLineNum(Index);
  620.                 END; (* ^PgUp *)
  621.  
  622.    kbCtrlPgDn : BEGIN
  623.                  ActFileData^.AssignDesc(EditStr);
  624.                  WriteFileEntry(Index,FALSE);
  625.  
  626.                  StartIndex := Max(FileList^.Count-ScreenSize,0);
  627.                  Index := FileList^.Count-1;
  628.                  RedrawScreen;
  629.                  UpdateLineNum(Index);
  630.                 END; (* ^PgDn *)
  631.  
  632.    kbAltD     : BEGIN
  633.                  ActFileData^.AssignDesc('');
  634.  
  635.                  Changed := TRUE;
  636.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  637.                  WriteFileEntry(Index,FALSE);
  638.                  NextIndex(Index);
  639.                 END; (* Alt-D *)
  640.  
  641.    kbAltM,
  642.    kbAltT     : BEGIN
  643.                  CutPasteDesc := ActFileData^.GetDesc;
  644.                  ActFileData^.AssignDesc(''); EditStr := '';
  645.  
  646.                  Changed := TRUE;
  647.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  648.                  WriteFileEntry(Index,FALSE);
  649.                  NextIndex(Index);
  650.                 END; (* Alt-M / Alt-T *)
  651.  
  652.    kbAltC     : BEGIN
  653.                  CutPasteDesc := ActFileData^.GetDesc;
  654.  
  655.                  DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  656.                  WriteFileEntry(Index,TRUE);
  657.                 END; (* Alt-C *)
  658.  
  659.    kbAltP     : IF CutPasteDesc > '' THEN
  660.                  BEGIN
  661.                   ActFileData^.AssignDesc(CutPasteDesc);
  662.                   WriteFileEntry(Index,FALSE);
  663.  
  664.                   Changed := TRUE;
  665.                   DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  666.                   NextIndex(Index);
  667.                  END; (* Alt-P *)
  668.  
  669.    kbF1       : BEGIN                                   (* F1: Help *)
  670.                  ShowHelp;
  671.                  ResetCursor(Overwrite);
  672.                  DrawMainScreen(Index,FileList^.Count);
  673.                  DrawDirLine;
  674.                  RedrawScreen;
  675.                  UpdateLineNum(Index);
  676.                 END;  (* F1 *)
  677.  
  678.    kbAltL,
  679.    kbF6       : BEGIN                                   (* F6: Change Drive *)
  680.                  IF Changed THEN QuerySaveDescriptions;
  681.  
  682.                  ASM
  683.                   mov ah,0eh       (* Select Disk *)
  684.                   mov dl,3
  685.                   int 21h
  686.                   add al,'@'
  687.                   mov LastDrv,al
  688.                  END;
  689.  
  690.                  (* Tom's solution has been commented out, Dave.
  691.                     Reason: LastDrive has not been detected correctly. *)
  692.  
  693.                  IF LastDrv > 'Z' THEN LastDrv := 'Z';
  694.  
  695.                  TextColor(StatusFg); TextBackGround(StatusBg); Drv := ' :';
  696.                  REPEAT
  697.                   GotoXY(1,MaxLines);
  698.                   Write(' New drive letter (A..',LastDrv,'): ');
  699.                   ClrEol;
  700.                   Drv[1] := UpCase(ReadKey);
  701.                  UNTIL (Drv[1] >= 'A') AND (Drv[1] <= LastDrv);
  702.                  IF Drv[1] <= 'B' THEN Drv := Drv + '\';
  703.                  OldDir := ActDir;
  704.                  ChDir(Drv); IORes := IOResult;
  705.                  IF IORes = 0 THEN
  706.                   BEGIN
  707.                    GetDir(0,ActDir); IORes := IOResult;
  708.                    ReadFiles;
  709.                    IF FileList^.Count = 0 THEN
  710.                     BEGIN
  711.                      IF (Length(OldDir) > 3) AND (OldDir[Length(OldDir)] = '\') THEN
  712.                        Delete(OldDir,Length(OldDir),1);
  713.                      ChDir(OldDir);
  714.                      ReportError('There are no files on drive '+Drv+'. Press any key.',(CutPasteDesc <> ''),Changed);
  715.                      ReadFiles;
  716.                     END;
  717.                    RedrawScreen;
  718.                    DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);;
  719.                    Index := 0;
  720.                    UpdateLineNum(Index);
  721.                   END
  722.                  ELSE
  723.                   ReportError('Drive '+Drv+' not ready! Drive remains unchanged, press a key.',(CutPasteDesc <> ''),Changed);
  724.                 END;  (* F6 *)
  725.  
  726.    kbF4       : DirDown; (* F4 *)
  727.    kbF5       : DirUp;   (* F5 *)
  728.  
  729.    kbEnter    : BEGIN
  730.                  ActFileData^.AssignDesc(EditStr);
  731.                  WriteFileEntry(Index,TRUE);
  732.                  IF (Index < FileList^.Count) THEN
  733.                   BEGIN
  734.                    n  := ActFileData^.GetName;
  735.  
  736.                    IF (ActFileData^.GetSize = DirSize) THEN
  737.                     IF (n[1] = '.') AND (n[2] = '.') THEN DirUp
  738.                     ELSE
  739.                     IF n[1] <> '.' THEN DirDown;
  740.                   END;
  741.                 END; (* Enter *)
  742.    kbF10,
  743.    kbF2      : BEGIN                                   (* F10: Save *)
  744.                 SaveDescriptions;
  745.                 UpdateLineNum(Index);
  746.                END; (* F10 or F2 *)
  747.    kbAltS,
  748.    kbShiftF10: BEGIN                                   (* Shell to 4DOS *)
  749.                 IF Changed THEN QuerySaveDescriptions;
  750.  
  751.                 DoneMemory;
  752.                 SetMemTop(HeapPtr);
  753.  
  754.                 NormVideo; ClrScr;
  755.                 WriteLn('Type `Exit'' to return to 4DESC.');
  756.                 SwapVectors;
  757.                 Exec(GetEnv('COMSPEC'),'');
  758.                 SwapVectors;
  759.  
  760.                 SetMemTop(HeapEnd);
  761.                 InitMemory;
  762.                 ClrScr;
  763.                 DrawMainScreen(Index,FileList^.Count);
  764.                 DrawStatusLine(TRUE,(CutPasteDesc <> ''),Changed);
  765.                 DrawDirLine;
  766.                 IF DosError > 0 THEN ReportError('Can''t load command interpreter / program execution failed.',
  767.                                                  (CutPasteDesc <> ''),Changed);;
  768.                 ReadFiles;
  769.                 RedrawScreen;
  770.                 UpdateLineNum(Index);
  771.                END;
  772.    kbAltV,
  773.    kbF3      : IF (Index < FileList^.Count) THEN
  774.                 BEGIN
  775.                  IF ActFileData^.GetSize <> DirSize THEN
  776.                   BEGIN                                  (* F3: View File *)
  777.                    FSplit(ActFileData^.GetName,NewDir,NewName,NewExt);
  778.                    StripTrailingSpaces(NewName);
  779.  
  780.                    DoneMemory;
  781.                    SetMemTop(HeapPtr);
  782.  
  783.                    SwapVectors;
  784.                    Exec(GetEnv('COMSPEC'),'/c '+ListCmd+' '+ActDir+'\'+NewName+NewExt);
  785.                    SwapVectors;
  786.  
  787.                    SetMemTop(HeapEnd);
  788.                    InitMemory;
  789.  
  790.                    ClrScr;
  791.                    DrawMainScreen(Index,FileList^.Count);
  792.                    DrawStatusLine(TRUE,(CutPasteDesc <> ''),Changed);
  793.                    DrawDirLine;
  794.                    IF DosError > 0 THEN ReportError('Can''t load command interpreter/program execution failed.',
  795.                                                    (CutPasteDesc <> ''),Changed);
  796.                    RedrawScreen;
  797.                    UpdateLineNum(Index);
  798.                  END;
  799.                 END;
  800.   ELSE
  801.    IF (Ord(Key) > 31) AND (Ord(Key) < 256) THEN
  802.     BEGIN
  803.      Changed := TRUE;
  804.      DrawStatusLine(FALSE,(CutPasteDesc <> ''),Changed);
  805.  
  806.      IF Overwrite AND (x <= Length(EditStr)) THEN
  807.       EditStr[x] := Chr(Key)
  808.      ELSE
  809.       EditStr := Copy(EditStr,1,x-1)+Chr(Key)+Copy(EditStr,x,255);
  810.      INC(x);
  811.      IF x > DescLen THEN x := DescLen;
  812.  
  813.      ActFileData^.AssignDesc(EditStr); WriteFileEntry(Index,TRUE);
  814.      GotoXY(EdStart+x-1,y);
  815.     END; (* all others *)
  816.  
  817.   END;  (* case *)
  818.  UNTIL (Key = kbEsc) OR (Key = kbAltX);
  819.  
  820.  IF Changed THEN QuerySaveDescriptions;
  821. END; (* EditDescriptions *)
  822.  
  823. (*-------------------------------------------------------- Main *)
  824. BEGIN
  825.  EdStart := 25+Length(DateFormat)+Length(TimeFormat);
  826.  DescLen := ScreenWidth-EdStart;
  827.  GetDir(0,StartDir); IORes := IOResult; DoShowHelp := FALSE;
  828.  IF ParamCount > 0 THEN
  829.   BEGIN
  830.    FOR i := 1 TO Min(2,ParamCount) DO
  831.     BEGIN
  832.      FirstParam := ParamStr(i);
  833.      IF (FirstParam[1] = '/') OR (FirstParam[1] = '-') THEN
  834.       BEGIN
  835.        IF NOT Monochrome THEN Monochrome := (UpCase(FirstParam[2]) = 'M');
  836.        IF NOT DoShowHelp THEN DoShowHelp := (UpCase(FirstParam[2]) = 'H') OR
  837.                                             (FirstParam[2] = '?');
  838.       END;
  839.     END;  (* for ... do begin *)
  840.    FSplit(ParamStr(ParamCount), NewDir, NewName, NewExt);
  841.    IF NewDir[Length(NewDir)] = '\' THEN NewDir[Length(NewDir)] := ' ';
  842.    ChDir(NewDir);
  843.   END;  (* if paramcount > 0 *)
  844.  IORes := IOResult;
  845.  Changed := FALSE; CutPasteDesc := '';
  846.  ChooseColors(Monochrome);
  847.  DrawMainScreen(0,0);
  848.  IF INIFileExists THEN
  849.   DelimiterTable := ReadSettingsString('misc','delimiters',DelimiterTable);
  850.  DelimiterTable := ' '+DelimiterTable;
  851.  
  852.  IF DoShowHelp THEN ShowHelp;
  853.  
  854.  InitMemory;
  855.  ReadFiles;
  856.  RedrawScreen;
  857.  EditDescriptions;
  858.  Dispose(FileList,Done); FileList := NIL;
  859.  DoneMemory;
  860.  
  861.  ChDir(StartDir);
  862.  SetCursorShape(OrigCursor);
  863.  NormVideo;
  864.  ClrScr;
  865.  WriteLn(Header);
  866.  WriteLn;
  867.  WriteLn('This program is freeware: you are allowed to use, copy it free');
  868.  WriteLn('of charge, but you may not sell or hire 4DESC.');
  869. END.
  870.